home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_PRO / DS-1.ZIP;1 / RUNTIME.ZIP / RMEMEXP.RI < prev    next >
Encoding:
Text File  |  1992-02-10  |  15.2 KB  |  504 lines
  1. /*
  2.  * File: rmemexp.ri - memory management functions for expandable regions
  3.  *  Contents: initalloc, reclaim, malloc, calloc, realloc, free
  4.  */
  5.  
  6. /*
  7.  * Prototypes.
  8.  */
  9.  
  10. hidden    novalue moremem    Params((uword units));
  11. hidden    novalue    reclaim    Params((int region));
  12.  
  13. /*
  14.  * initalloc - initialization routine to allocate memory regions
  15.  */
  16.  
  17. #if COMPILER
  18. novalue initalloc()
  19.    {
  20.    char *allocbase;
  21. #else                    /* COMPILER */
  22. novalue initalloc(codesize)
  23. word codesize;
  24.    {
  25.  
  26. #if MACINTOSH
  27. #if MPW
  28.    extern word xcodesize;
  29.    xcodesize = codesize;
  30. #endif                    /* MPW */
  31. #endif                    /* MACINTOSH */
  32. #endif                    /* COMPILER */
  33.  
  34.    /*
  35.     * Set up allocated memory.    The regions are:
  36.     *
  37.     *    Static memory region
  38.     *    Allocated string region
  39.     *    Allocate block region
  40.     *    Qualifier list
  41.     */
  42.  
  43. #if COMPILER
  44.    /*
  45.     * Establish allocation base
  46.     */
  47.    allocbase = (char *)sbrk((word)0);
  48.    statfree = statbase = (char *)((uword)allocbase  & ~03);
  49. #else                    /* COMPILER
  50.    /*
  51.     * Establish icode region
  52.     */
  53.    code = (char *)sbrk((word)0);
  54.  
  55.    statfree = statbase = (char *)((uword)(code + codesize + 3)  & ~03);
  56. #endif                    /* COMPILER */
  57.  
  58. /*
  59.  * The following code is operating-system dependent [@rmemexp.01].  Set end of
  60.  *  static region, rounding up if necessary.
  61.  */
  62.  
  63. #if PORT
  64.    statend = (char *)(((uword)statbase) + mstksize + statsize);
  65. Deliberate Syntax Error
  66. #endif                    /* PORT */
  67.  
  68. #if AMIGA || ARM || OS2 || ((MVS || VM) && !SASC)
  69.    /* use fixed regions */
  70. #endif                    /* AMIGA || ARM || OS2 || ... */
  71.  
  72. #if ATARI_ST || SASC || UNIX || VMS
  73.    statend = (char *)(((uword)statbase) + mstksize + statsize);
  74. #endif                    /* ATARI_ST || SASC || .. */
  75.  
  76. #if MACINTOSH
  77. #if MPW
  78.    statend = (char *)(((uword)statbase) + mstksize + statsize);
  79. #endif                    /* MPW */
  80. #endif                    /* MACINTOSH */
  81.  
  82. #if MSDOS
  83.    statend =
  84.       (char *)(((uword)statbase) + (((mstksize + statsize + 511)/512) * 512));
  85. #endif                    /* MSDOS */
  86.  
  87. /*
  88.  * End of operating-system specific code.
  89.  */
  90.  
  91.    strfree = strbase = (char *)((uword)(statend + 63) & ~077);
  92.    blkfree = blkbase = strend = (char *)((((uword)strbase) + ssize +
  93.       63) & ~077);
  94.    equallist = (dptr *)(blkend =
  95.       (char *)((((uword)(blkbase) + abrsize + 63)) & ~077));
  96.  
  97.    /*
  98.     * Try to move the break back to the end of memory to allocate (the
  99.     *  end of the string qualifier list) and die if the space isn't
  100.     *  available.
  101.     */
  102.    if ((int)brk((char *)equallist) == -1)
  103.       error("insufficient memory");
  104.    currend = (char *)sbrk((word)0);    /* keep track of end of memory */
  105.    }
  106.  
  107. /*
  108.  * reclaim - reclaim space in the allocated memory regions. The marking
  109.  *  phase has already been completed.
  110.  */
  111.  
  112. static novalue reclaim(region)
  113. int region;
  114. {
  115.    register word stat_extra, str_extra, blk_extra;
  116.    register char *newend;
  117.  
  118.    stat_extra = 0;
  119.    str_extra = 0;
  120.    blk_extra = 0;
  121.  
  122.    /*
  123.     * Collect available co-expression blocks.
  124.     */
  125.    cofree();
  126.  
  127.    /*
  128.     * If there was no room to construct the qualifier list, the string
  129.     *  region cannot be collected and the static region cannot be expanded.
  130.     */
  131.    if (!qualfail) {
  132.       /*
  133.        * Check whether the static region needs to be expanded. Regions cannot
  134.        *  be expanded if someone else has moved the end of allocated storage.
  135.        */
  136.       if (statneed && currend == (char *)sbrk((word)0)) {
  137.          /*
  138.           * Make sure there is space for the requested static region expansion.
  139.           *  The check involving equallist and newend appears to only be
  140.           *  required on machines where the above addition of statneed might
  141.           *  overflow.
  142.           */
  143.          newend = (char *)equallist + statneed;
  144.          if ((uword)newend >= (uword)(char *)equallist &&
  145.              (int)brk((char *)newend) != -1) {
  146.                stat_extra = statneed;
  147.                statneed = 0;
  148.                statend += stat_extra;
  149.                equallist = (dptr *)newend;
  150.                currend = (char *)sbrk((word)0);
  151.                }
  152.          }
  153.  
  154.       /*
  155.        * Collect the string space, indicating that it must be moved back
  156.        *  extra bytes.
  157.        */
  158.       scollect(stat_extra);
  159.  
  160.       if (region == Strings && currend == (char *)sbrk((word)0)) {
  161.          /*
  162.           * Calculate a value for extra space.  The value is (the larger of
  163.           *  (twice the string space needed) or (a quarter of the string space))
  164.           *  minus the unallocated string space.
  165.           */
  166.          str_extra = (Max(2*strneed, ((uword)strend - (uword)strbase)/4) -
  167.                ((uword)strend - (uword)strfree) + (GranSize-1)) & ~(GranSize-1);
  168.          while (str_extra > 0) {
  169.             /*
  170.              * Try to get str_extra more bytes of storage.  If it can't be
  171.              *  gotten, decrease the value by GranSize and try again.  If
  172.              *  it's gotten, move back equallist.
  173.              */
  174.             newend = (char *)equallist + str_extra;
  175.             if ((uword)newend >= (uword)(char *)equallist &&
  176.                 (int)brk((char *)newend) != -1) {
  177.                    equallist = (dptr *) newend;
  178.                    currend = (char *)sbrk((word)0);
  179.                    break;
  180.                    }
  181.             str_extra -= GranSize;
  182.             }
  183.          if (str_extra < 0)
  184.             str_extra = 0;
  185.          }
  186.       }
  187.  
  188.    /*
  189.     * Adjust the pointers in the block region.
  190.     */
  191.    adjust(blkbase, blkbase + stat_extra + str_extra);
  192.  
  193.    /*
  194.     * Compact the block region.
  195.     */
  196.    compact(blkbase);
  197.  
  198.    if (region == Blocks && currend == (char *)sbrk((word)0)) {
  199.       /*
  200.        * Calculate a value for extra space.  The value is (the larger of
  201.        *  (twice the block region space needed) or (one quarter of the
  202.        *  block region)) plus the unallocated block space.
  203.        */
  204.       blk_extra = (Max(2*blkneed, ((uword)blkend - (uword)blkbase)/4) -
  205.                ((uword)blkend - (uword)blkfree) + (GranSize-1)) & ~(GranSize-1);
  206.       while (blk_extra > 0) {
  207.          /*
  208.           * Try to get blk_extra more bytes of storage.  If it can't be gotten,
  209.           *  decrease the value by GranSize and try again.  If it's gotten,
  210.           *  move back equallist.
  211.           */
  212.          newend = (char *)equallist + blk_extra;
  213.          if ((uword)newend >= (uword)(char *)equallist &&
  214.              (int)brk((char *)newend) != -1) {
  215.                 equallist = (dptr *) newend;
  216.                 currend = (char *)sbrk((word)0);
  217.                 break;
  218.                 }
  219.          blk_extra -= GranSize;
  220.          }
  221.       if (blk_extra < 0)
  222.          blk_extra = 0;
  223.    }
  224.  
  225.    if (stat_extra + str_extra > 0) {
  226.       /*
  227.        * The block region must be moved.  There is an assumption here that the
  228.        *  block region always moves up in memory, i.e., the static and
  229.        *  string regions never shrink.    With this assumption in hand,
  230.        *  the block region must be moved before the string space lest the
  231.        *  string space overwrite block data.  The assumption is valid,
  232.        *  but beware if shrinking regions are ever implemented.
  233.        */
  234.       mvc((uword)blkfree - (uword)blkbase, blkbase, blkbase + stat_extra +
  235.          str_extra);
  236.       blkbase += stat_extra + str_extra;
  237.       blkfree += stat_extra + str_extra;
  238.       }
  239.    blkend += stat_extra + str_extra + blk_extra;
  240.  
  241.    if (stat_extra > 0) {
  242.       /*
  243.        * The string space must be moved up in memory.
  244.        */
  245.       mvc((uword)strfree - (uword)strbase, strbase, strbase + stat_extra);
  246.       strbase += stat_extra;
  247.       strfree += stat_extra;
  248.       }
  249.    strend += stat_extra + str_extra;
  250.    }
  251.  
  252. /*
  253.  * These are Icon's own versions of the allocation routines.  They are
  254.  *  not used for the fixed-regions versions of memory management.  They
  255.  *  normally overload the corresponding library routines. If this is not
  256.  *  possible, they are re-named and calls to them are renamed.
  257.  */
  258.  
  259. static HEADER base;        /* start with empty list */
  260. static HEADER *allocp = NULL;    /* last allocated block */
  261.  
  262. #if LATTICE || LSC
  263. #define nothing 0
  264. int free(ap)
  265. #else                    /* LATTICE || LSC */
  266. #define nothing
  267. novalue free(ap)        /* return block pointed to by ap to free list */
  268. #endif                    /* LATTICE || LSC */
  269. pointer ap;
  270.    {
  271.    register HEADER *p, *q;
  272.  
  273. /* free may be called to free a block before the static region is
  274.  *  initialized.  Memory will be lost.
  275.  */
  276.    if (statbase == (char *)NULL || (char *)ap < statbase)
  277.       return nothing;
  278.  
  279.    p = (HEADER *)ap - 1;    /* point to header */
  280.  
  281. #ifdef MemMon
  282.    if (p->s.bsize > 1)    {
  283.       if (*(int *)(p + 1) != T_Coexpr)
  284.          MMStat((char *)ap, (word)((p->s.bsize - 1) * sizeof(HEADER)), 'F');
  285.       *(int *)(p + 1) = FREEMAGIC;
  286.       }
  287. #endif                    /* MemMon */
  288.  
  289.    if (p->s.bsize * sizeof(HEADER) >= statneed)
  290.      statneed = 0;
  291.    for (q = allocp; !((uword)p > (uword)q && (uword)p < (uword)q->s.ptr);
  292.       q = q->s.ptr)
  293.          if ((uword)q >= (uword)q->s.ptr && ((uword)p > (uword)q ||
  294.             (uword)p < (uword)q->s.ptr))
  295.                break;         /* at one end or the other */
  296.    if ((uword)p + sizeof(HEADER) * p->s.bsize
  297.       == (uword)q->s.ptr) {    /* join to upper */
  298.       p->s.bsize += q->s.ptr->s.bsize;
  299.       if (p->s.bsize * sizeof(HEADER) >= statneed)
  300.          statneed = 0;
  301.       p->s.ptr = q->s.ptr->s.ptr;
  302.       }
  303.    else
  304.       p->s.ptr = q->s.ptr;
  305.    if ((uword)q + sizeof(HEADER) * q->s.bsize ==
  306.       (uword)p) {        /* join to lower */
  307.          q->s.bsize += p->s.bsize;
  308.          if (q->s.bsize * sizeof(HEADER) >= statneed)
  309.             statneed = 0;
  310.          q->s.ptr = p->s.ptr;
  311.          }
  312.    else
  313.       q->s.ptr = p;
  314.    allocp = q;
  315.    }
  316.  
  317. pointer malloc(nbytes)
  318. msize nbytes;
  319.    {
  320.    register HEADER *p, *q, *r;
  321.    register uword nunits;
  322.    register pointer xbase;
  323.    int attempts;
  324.  
  325.    if (statbase == NULL) {        /* allocate in uword multiples */
  326.       if ((xbase = (char *)sbrk((nbytes + sizeof(msize) + sizeof(uword) - 1)
  327.        & ~(sizeof(uword) - 1))) == (pointer)-1)
  328.          syserr("malloc: failed during startup");
  329.       *((msize *)xbase) = nbytes;    /* record allocation size */
  330.       stattotal += nbytes + sizeof(msize);
  331.       return (pointer)((uword)xbase + sizeof(msize));
  332.       }
  333.  
  334.    nunits = 1 + (nbytes + sizeof(HEADER) - 1) / sizeof(HEADER);
  335.  
  336.    if ((q = allocp) == NULL) {    /* no free list yet */
  337.       base.s.ptr = allocp = q = &base;
  338.       base.s.bsize = 0;
  339.       }
  340.  
  341.    for (attempts = 2; attempts--; q = allocp) {
  342.       for (p = q->s.ptr;; q = p, p = p->s.ptr) {
  343.          if (p->s.bsize >= nunits) {    /* block is big enough */
  344.             if (p->s.bsize == nunits)    /* exactly right */
  345.                q->s.ptr = p->s.ptr;
  346.             else {            /* allocate head end */
  347.                r = p + nunits;
  348.                r->s.bsize = p->s.bsize - nunits;
  349.                r->s.ptr = p->s.ptr;
  350. #ifdef MemMon
  351.            if (r->s.bsize > 1)
  352.                   *(int *)(r + 1) = FREEMAGIC;    /* mark free portion */
  353. #endif                    /* MemMon */
  354.                q->s.ptr = r;
  355.                p->s.bsize = nunits;
  356.                }
  357.             allocp = q;
  358.  
  359. #ifdef MemMon
  360.             if (nunits > 1)   {
  361.                MMStat((char *)(p + 1), (word) nbytes, E_Alien);
  362.                *(int *)(p + 1) = 0;    /* clear FREEMAGIC flag */
  363.                }
  364. #endif                    /* MemMon */
  365.  
  366.         stattotal += sizeof(HEADER) * nunits;
  367.             return (char *)(p + 1);
  368.             }
  369.          if (p == allocp) {    /* wrap around */
  370.             moremem(nunits);    /* garbage collect and expand if needed */
  371.             break;
  372.             }
  373.          }
  374.       }
  375.  
  376.       return NULL;
  377.    }
  378.  
  379. #define FREESIZE 2    /* units sizeof(HEADER) that justify free() */
  380.  
  381. /*
  382.  *  realloc() allocates a block of memory of a requested size (amount) to
  383.  *  contain the contents of the current block (curmem) or as much as will
  384.  *  fit.  Blocks are allocated in units of sizeof(HEADER)
  385.  */
  386.  
  387. pointer realloc(curmem,newsiz)
  388. register pointer curmem;        /* the current memory pointer */
  389. msize newsiz;                /* bytes needed for new allocation */
  390.    {
  391.    register int cunits;        /* currently allocated units */
  392.    register int nunits;        /* new units required */
  393.    char *newmem;        /* the new memory pointer */
  394.    register HEADER *head;    /* all blocks used or free have a header */
  395.    msize csiz;            /* current size of block */
  396.  
  397. /*
  398.  *  realloc may be called to resize a block allocated before the static
  399.  *  region was initialized.
  400.  */
  401.  
  402. /*
  403.  * Some systems allow realloc to be called with zero for curmem.  In
  404.  * this case, treat it as a malloc.
  405.  */
  406.  
  407.    if (curmem == (pointer)NULL)
  408.       return malloc(newsiz);
  409.  
  410.    if (statbase == (char *) NULL || (char *)curmem < statbase) {
  411.       csiz = *((msize *)((uword)curmem - sizeof(msize)));
  412.       if (newsiz <= csiz)
  413.          return curmem;
  414.       else {            /* more space needed */
  415.          if ((newmem = malloc((msize)newsiz)) != NULL) {
  416.             memcopy(newmem,curmem,(word)csiz);
  417.             free(curmem);
  418.             return newmem;
  419.             }
  420.          else
  421.             return NULL;
  422.          }
  423.       }
  424.  
  425.    /*
  426.     * First establish the unit sizes involved.
  427.     */
  428.  
  429.    nunits = 1 + (newsiz + sizeof(HEADER) - 1) / sizeof(HEADER);
  430.    head = ((HEADER *)curmem) - 1;    /* move back a block header */
  431.    cunits = (int)head->s.bsize;
  432.  
  433.    /*
  434.     * Now allocate or free space as required.
  435.     */
  436.  
  437.    if (nunits <= cunits) {    /* we already have the space */
  438.       if (cunits - nunits < FREESIZE)
  439.          return curmem;
  440.       else {            /* free space at end of current block */
  441.          head->s.bsize = nunits;    /* reduce space used */
  442.          head += nunits;        /* move to free space */
  443.          head->s.bsize = cunits - nunits;
  444.          free((pointer)(++head));    /* free this new block */
  445.          return curmem;
  446.          }
  447.       }
  448.    else {                /* more space needed */
  449.       if ((newmem = malloc((msize)newsiz)) != NULL) {
  450.          memcopy(newmem,curmem,(word)((cunits - 1) * sizeof(HEADER)));
  451.          free(curmem);
  452.          return newmem;
  453.          }
  454.       }
  455.    return NULL;
  456.    }
  457.  
  458. /*
  459.  * calloc() allocates ecnt number of esiz-sized chunks of zero-initialized
  460.  * memory for an array of ecnt elements.
  461.  */
  462.  
  463. pointer calloc(ecnt,esiz)
  464.    register msize ecnt, esiz;
  465.    {
  466.    register char *mem;            /* the memory pointer */
  467.    register msize amount;        /* the amount of memory needed */
  468.  
  469.    amount = ecnt * esiz;
  470.    if ((mem = malloc(amount)) != NULL) {
  471.       memfill(mem,0,(word)amount);        /* initialize it to zero */
  472.       return mem;
  473.       }
  474.    return NULL;
  475.    }
  476.  
  477. /*
  478.  * moremem - create a block from the end of the static region and add it
  479.  *  to the free list. If there is not enough room there for the current
  480.  *  request do a garbage collection first.
  481.  */
  482. static novalue moremem(nunits)
  483. uword nunits;
  484.    {
  485.    register HEADER *up;
  486.    register word rnu;
  487.    word n;
  488.  
  489.    rnu = NALLOC * ((nunits + NALLOC - 1) / NALLOC);
  490.    n = rnu * sizeof(HEADER);
  491.  
  492.    if (((uword)statfree) + n > (uword)statend)
  493.       collect(Static, n);
  494.    /*
  495.     * See if there is any room left.
  496.     */
  497.    if ((uword)statend - (uword)statfree > sizeof(HEADER)) {
  498.       up = (HEADER *) statfree;
  499.       up->s.bsize = ((uword)statend - (uword)statfree) / sizeof(HEADER);
  500.       statfree = (char *) (up + up->s.bsize);
  501.       free((pointer)(up + 1));    /* add block to free memory */
  502.       }
  503.    }
  504.